home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVDMX / STDDMX.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  15KB  |  566 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    StdDMX     --Standard tvDMX Interface Unit    }
  5. {    tvDMX     --data editing project (ver 2.x)    }
  6. {                            }
  7. {    Copyright (c) 1992,93    Randolph Beck        }
  8. {                P.O. Box  56-0487    }
  9. {                Orlando, FL 32856    }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Unit StdDMX;
  15.  
  16. {$B-,D+,O+,R-,X+,V- }
  17.  
  18. interface
  19.  
  20. uses  Objects, Drivers, Views, Dialogs, App, MsgBox,
  21.       RSet, tvGizma, DmxGizma, tvDMX;
  22.  
  23. const    CDmxEditDlg    = #19#20#06#06#01#02; { similar to CInputLine }
  24.              {  |  |  |  |    |  | }
  25.   {  1 normal fields -------+  |  |  |    |  | }
  26.   {  2 normal selected field --+  |  |    |  | }
  27.   {  3 read-only selected field --+  |    |  | }
  28.   {  4 locked field -----------------+    |  | }
  29.   {  5 delimiter -----------------------+  | }
  30.   {  6 border -----------------------------+ }
  31.  
  32. type
  33.     PDmxEditDlg     = ^TDmxEditDlg;  { tvDMX editor for dialog boxes }
  34.     PInputFields = ^TInputFields; { line-editor for dialog boxes }
  35.     PValidFields = ^TValidFields; { validating line-editor }
  36.     PDmxViewer     = ^TDmxViewer;   { tvDMX data scroller window }
  37.     PDmxWindow     = ^TDmxWindow;   { tvDMX data editor window  }
  38.  
  39.  
  40.     TDmxEditDlg     =  OBJECT(TDmxEditor)
  41.       function    GetPalette : PPalette;  VIRTUAL;
  42.     end;
  43.  
  44.  
  45.     TInputFields =  OBJECT(TDmxEditDlg)
  46.     StdEnter    : boolean;
  47.       constructor Init(InfoStr: string; var Bounds: TRect);
  48.       procedure InitData(var AData );  VIRTUAL;
  49.       procedure DoneData;  VIRTUAL;
  50.       procedure LoadData(var S: TStream);  VIRTUAL;
  51.       procedure StoreData(var S: TStream);  VIRTUAL;
  52.       function    DataSize : word;  VIRTUAL;
  53.       procedure GetData(var Rec );  VIRTUAL;
  54.       procedure SetData(var Rec );  VIRTUAL;
  55.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  56.       procedure SetState(AState: word; Enable: boolean);  VIRTUAL;
  57.       procedure SetUpField;  VIRTUAL;
  58.     end;
  59.  
  60.  
  61.     TValidFields  =  OBJECT(TInputFields)
  62.     VLo,VHi     : integer;
  63.       constructor Init(InfoStr: string; var Bounds: TRect; ALo,AHi: integer);
  64.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  65.       function    Valid(Command: word) : boolean;  VIRTUAL;
  66.     end;
  67.  
  68.  
  69.     TDmxViewer     =  OBJECT(TLtdWindow)
  70.     DMX    : PDmxEditor;
  71.       constructor Init(var Bounds: TRect;  ATitle: TTitleStr;  ANumber: integer;
  72.             ATemplate: string;  var AData;  BSize: longint;
  73.             var ALabels: string);
  74.       constructor Load(var S: TStream);
  75.       procedure InitDMX(ATemplate: string;  var AData;
  76.             ALabels, ARecInd: PDmxLink;
  77.             BSize: longint);  VIRTUAL;
  78.       function    NewDmxLabels(var ALabels ) : PDmxLink;    VIRTUAL;
  79.       procedure Store(var S: TStream);
  80.       function    Valid(Command: word) : boolean;  VIRTUAL;
  81.     end;
  82.  
  83.  
  84.     TDmxWindow     =  OBJECT(TDmxViewer)
  85.       constructor Init(var Bounds: TRect;  ATitle: TTitleStr;  ANumber: integer;
  86.             ATemplate: string;  var AData;  BSize: longint;
  87.             var ALabels: string;    IndLen    : integer);
  88.       procedure InitDMX(ATemplate: string;  var AData;
  89.             ALabels, ARecInd: PDmxLink;
  90.             BSize: longint);  VIRTUAL;
  91.       function    NewRecInd(Len: integer) : PDmxLink;  VIRTUAL;
  92.     end;
  93.  
  94.  
  95.  
  96.   procedure GetBlob(Num: integer; var Blob: pointer; var Len: integer);
  97.  
  98.  
  99.   function  InsertField(Dialog: PDialog;  Col,Row: integer;
  100.             Fmt: boolean;  ALabel,ATemplate: string) : PInputFields;
  101.  
  102.   function  ValidField(Dialog: PDialog;    Col,Row, ALo,AHi: integer;
  103.             Fmt: boolean;  ALabel,ATemplate: string) : PValidFields;
  104.  
  105.   procedure RegisterStdDMX;
  106.  
  107.  
  108. const
  109.     RDmxEditDlg    :  TStreamRec =(
  110.     ObjType:  rnDmxEditDlg;
  111.     VmtLink:  ofs(TypeOf(TDmxEditDlg)^);
  112.     Load:      @TDmxEditDlg.Load;
  113.     Store:      @TDmxEditDlg.Store
  114.       );
  115.  
  116.     RInputFields :  TStreamRec =(
  117.     ObjType:  rnInputFields;
  118.     VmtLink:  ofs(TypeOf(TInputFields)^);
  119.     Load:      @TInputFields.Load;
  120.     Store:      @TInputFields.Store
  121.       );
  122.  
  123.     RValidFields :  TStreamRec =(
  124.     ObjType:  rnValidFields;
  125.     VmtLink:  ofs(TypeOf(TValidFields)^);
  126.     Load:      @TValidFields.Load;
  127.     Store:      @TValidFields.Store
  128.       );
  129.  
  130.     RDmxViewer    :  TStreamRec =(
  131.     ObjType:  rnDmxViewer;
  132.     VmtLink:  ofs(TypeOf(TDmxViewer)^);
  133.     Load:      @TDmxViewer.Load;
  134.     Store:      @TDmxViewer.Store
  135.       );
  136.  
  137.     RDmxWindow    :  TStreamRec =(
  138.     ObjType:  rnDmxWindow;
  139.     VmtLink:  ofs(TypeOf(TDmxWindow)^);
  140.     Load:      @TDmxWindow.Load;
  141.     Store:      @TDmxWindow.Store
  142.       );
  143.  
  144.  
  145. implementation
  146.  
  147.   { ══════════════════════════════════════════════════════════════════════ }
  148.  
  149.  
  150. procedure GetBlob(Num: integer; var Blob: pointer; var Len: integer);
  151. var  P : PDmxEditor;
  152. begin
  153.   Blob := nil;
  154.   Len  := 0;
  155.   P := Message(DeskTop, evCommand, cmDMX_RollCall, nil);
  156.   If (P <> nil) then P^.GetBlob(Num, Blob, Len);
  157. end;
  158.  
  159.  
  160.   { ══════════════════════════════════════════════════════════════════════ }
  161.  
  162.  
  163. function  InsertField(Dialog: PDialog;  Col,Row: integer;
  164.               Fmt: boolean;  ALabel,ATemplate: string) : PInputFields;
  165. var  i    : integer;
  166.      R    : TRect;
  167.      B    : PInputFields;
  168. begin
  169.   With Dialog^ do
  170.     begin
  171.     i  := succ(CStrLen(ALabel));
  172.     R.Assign(Col, Row, Col + DmxStrLen(ATemplate), succ(Row));
  173.     If (ALabel <> '') then
  174.       begin
  175.       If Fmt then R.Move(1, 1) else R.Move(i, 0);
  176.       end;
  177.     B  := New(PInputFields, Init(ATemplate, R));
  178.     Insert(B);
  179.     If (ALabel <> '') then
  180.       begin
  181.       R.Assign(Col, Row, Col + i, succ(Row));
  182.       Insert(New(PLabel, Init(R, ALabel, B)));
  183.       end;
  184.     end;
  185.   InsertField := B;
  186. end;
  187.  
  188.  
  189.   { ══════════════════════════════════════════════════════════════════════ }
  190.  
  191.  
  192. function  ValidField(Dialog: PDialog;    Col,Row, ALo,AHi: integer;
  193.              Fmt: boolean;  ALabel,ATemplate: string) : PValidFields;
  194. var  i    : integer;
  195.      R    : TRect;
  196.      B    : PValidFields;
  197. begin
  198.   With Dialog^ do
  199.     begin
  200.     i := succ(CStrLen(ALabel));
  201.     R.Assign(Col, Row, Col + DmxStrLen(ATemplate), succ(Row));
  202.     If (ALabel <> '') then
  203.       begin
  204.       If Fmt then R.Move(1, 1) else R.Move(i, 0);
  205.       end;
  206.     B := New(PValidFields, Init(ATemplate, R, ALo,AHi));
  207.     Insert(B);
  208.     If (ALabel <> '') then
  209.       begin
  210.       R.Assign(Col, Row, Col + i, succ(Row));
  211.       Insert(New(PLabel, Init(R, ALabel, B)));
  212.       end;
  213.     end;
  214.   ValidField := B;
  215. end;
  216.  
  217.  
  218.   { ══ TValidFields ══════════════════════════════════════════════════════ }
  219.  
  220.  
  221. constructor TValidFields.Init(InfoStr: string; var Bounds: TRect;  ALo,AHi: integer);
  222. begin
  223.   TInputFields.Init(InfoStr, Bounds);
  224.   VLo := ALo;
  225.   VHi := AHi;
  226. end;
  227.  
  228.  
  229. procedure TValidFields.HandleEvent(var Event: TEvent);
  230. begin
  231.   If (Event.What <> evKeyDown) or (Event.CharCode in[#0..#31,'0'..'9']) then
  232.     TInputFields.HandleEvent(Event);
  233. end;
  234.  
  235.  
  236. function  TValidFields.Valid(Command: word) : boolean;
  237. var  i       : integer;
  238.      Range : array[0..1] of longint;
  239.      S       : string;
  240.      R       : TRect;
  241. begin
  242.   If (Command = cmValid) or (Command = cmCancel) or
  243.     ((integer(WorkingData^) >= VLo) and (integer(WorkingData^) <= VHi)) then
  244.     TInputFields.Valid(Command)
  245.    else
  246.     begin
  247.     Range[0] := VLo;
  248.     Range[1] := VHi;
  249.     If (TypeOf(Prev^) = TypeOf(TLabel)) and (PLabel(Prev)^.Link = @Self) and
  250.        (PLabel(Prev)^.Text <> nil) and (PLabel(Prev)^.Text^ <> '') then
  251.       begin
  252.       S := PLabel(Prev)^.Text^;
  253.       For i := length(S) downto 1 do
  254.     If (S[i] = '~') or ((i = length(S)) and (S[i] in[' ',':'])) then
  255.       Delete(S,i,1);
  256.       end
  257.      else
  258.       S := 'Selection';
  259.     R.Assign(0, 0, 50, 9);
  260.     R.Move((Desktop^.Size.X - R.B.X) div 2,(Desktop^.Size.Y - R.B.Y) div 2);
  261.     MessageBoxRect(R, S + ' is out of valid range:'^M^M^C'%d to %d', @Range, mfError + mfOKButton);
  262.     Valid := FALSE;
  263.     Select;
  264.     end;
  265. end;
  266.  
  267.  
  268.   { ══ TDmxEditDlg ══════════════════════════════════════════════════════ }
  269.  
  270.  
  271. function  TDmxEditDlg.GetPalette : PPalette;
  272. const  A : string[length(CDmxEditDlg)] = CDmxEditDlg;
  273. begin
  274.   GetPalette := @A
  275. end;
  276.  
  277.  
  278.   { ══ TInputFields ══════════════════════════════════════════════════════ }
  279.  
  280.  
  281. constructor TInputFields.Init(InfoStr: string;  var Bounds: TRect);
  282. var  S      : string;
  283.      void : integer;
  284. begin
  285.     { init with no data }
  286.   S := ^A + InfoStr;
  287.   TDmxEditDlg.Init(S, void, 0, Bounds, nil,nil, nil,nil);
  288.   GrowMode := gfGrowHiX;
  289.   Options  := Options or ofFirstClick;
  290.   StdEnter := TRUE;
  291. end;
  292.  
  293.  
  294. procedure TInputFields.InitData(var AData );
  295. { allocates memory for the data }
  296. begin
  297.   DataBlockSize := Size.Y * RecordSize;  { correct improper size }
  298.   GetMem(WorkingData, DataBlockSize);
  299.   fillchar(WorkingData^, DataBlockSize, 0);
  300.   TDmxEditDlg.InitData(WorkingData^);
  301. end;
  302.  
  303.  
  304. procedure TInputFields.DoneData;
  305. begin
  306.   TDmxEditDlg.DoneData;
  307.   FreeMem(WorkingData, DataBlockSize);
  308. end;
  309.  
  310.  
  311. procedure TInputFields.LoadData(var S: TStream);
  312. begin
  313.   S.Read(StdEnter, sizeof(StdEnter));
  314.   S.Read(DataBlockSize, sizeof(DataBlockSize));
  315.   GetMem(WorkingData,  DataBlockSize);
  316.   S.Read(WorkingData^, DataBlockSize);
  317. end;
  318.  
  319.  
  320. procedure TInputFields.StoreData(var S: TStream);
  321. begin
  322.   S.Write(StdEnter, sizeof(StdEnter));
  323.   S.Write(DataBlockSize, sizeof(DataBlockSize));
  324.   S.Write(WorkingData^, DataBlockSize);
  325. end;
  326.  
  327.  
  328. function  TInputFields.DataSize : word;
  329. begin
  330.   DataSize := LongRec(DataBlockSize).Lo
  331. end;
  332.  
  333.  
  334. procedure TInputFields.GetData(var Rec );
  335. var  Len : word;
  336. begin
  337.   Len  := DataSize;
  338.   If (Len > 0) and (WorkingData <> nil) then Move(WorkingData^, Rec, Len);
  339. end;
  340.  
  341.  
  342. procedure TInputFields.SetData(var Rec );
  343. var  Len : word;
  344. begin
  345.   Len  := DataSize;
  346.   If (Len > 0) and (WorkingData <> nil) then Move(Rec, WorkingData^, Len);
  347.   DrawView;
  348. end;
  349.  
  350.  
  351. const  Initing : boolean = FALSE;
  352.  
  353.  
  354. procedure TInputFields.HandleEvent(var Event: TEvent);
  355.     function  AtEndField : boolean;
  356.     var  F : pDMXfieldrec;
  357.     begin
  358.       F := CurrentField;
  359.       Repeat
  360.     F := F^.Next;
  361.       Until (F = nil) or ((F^.fieldsize > 0) and (F^.access and accSkip = 0));
  362.       AtEndField := (F = nil);
  363.     end;
  364. begin
  365.   With Event do
  366.     If (What = evKeyboard) then
  367.       begin
  368.       If (KeyCode = kbEnter) and StdEnter and AtEndField then
  369.     begin
  370.     TScroller.HandleEvent(Event);
  371.     Exit;
  372.     end
  373.        else
  374.     begin
  375.     If ((KeyCode = kbPgUp) or (KeyCode = kbUp)) and (CurrentRecord = 0) then
  376.       KeyCode := kbShiftTab;
  377.     If ((KeyCode = kbPgDn) or (KeyCode = kbDown)
  378.       or ((KeyCode = kbEnter) and AtEndField))
  379.       and (succ(CurrentRecord) = Limit.Y)
  380.      then
  381.       KeyCode := kbTab;
  382.     end;
  383.       end
  384.     else
  385.     If (What = evBroadcast) and (Command = cmDMX_RollCall) and Initing and
  386.        (InfoPtr <> @Self) then
  387.       begin
  388.       StdEnter := FALSE;
  389.       end;
  390.   TDmxEditDlg.HandleEvent(Event);
  391. end;
  392.  
  393.  
  394. procedure TInputFields.SetState(AState: word; Enable: boolean);
  395. var  cmd    : word;
  396.      voidXY : TPoint;
  397. begin
  398.   If (AState and sfFocused <> 0) and not Enable then JustAltered := FALSE;
  399.   TDmxEditDlg.SetState(AState, Enable);
  400.   If Enable and (AState and sfFocused <> 0) then
  401.     begin
  402.     cmd  := cmDMX_Home;
  403.     ProcessCommand(cmd, voidXY);
  404.     end
  405.   else
  406.   If Enable and (AState and sfExposed <> 0) then
  407.     begin
  408.     If (Owner <> nil) then
  409.       begin
  410.       Initing := TRUE;
  411.       Message(Owner, evBroadcast, cmDMX_RollCall, @Self);
  412.       Initing := FALSE;
  413.       end;
  414.     end;
  415. end;
  416.  
  417.  
  418. procedure TInputFields.SetUpField;
  419. begin
  420.   TDmxEditDlg.SetUpField;
  421.   If (CurrentField <> nil) and
  422.      (upcase(CurrentField^.typecode) in[fldSTR, fldSTRNUM, fldCHAR, fldCHARNUM])
  423.    then
  424.     FirstKey := FALSE;
  425. end;
  426.  
  427.  
  428.   { ══ TDmxViewer ════════════════════════════════════════════════════════ }
  429.  
  430.  
  431. constructor TDmxViewer.Init(var Bounds       : TRect;
  432.                 ATitle     : TTitleStr;
  433.                 ANumber    : integer;
  434.                 ATemplate  : string;
  435.                 var AData;
  436.                 BSize       : longint;
  437.                 var ALabels    : string);
  438. const  NilWin    : array[0..1] of Longint = (0,0);
  439. begin
  440.   TLtdWindow.Init(Bounds, TRect(NilWin), ATitle, ANumber);
  441.   InitDMX(ATemplate, AData, NewDmxLabels(ALabels), nil, BSize);
  442.   Options := Options or ofTileable;
  443. end;
  444.  
  445.  
  446. constructor TDmxViewer.Load(var S: TStream);
  447. begin
  448.   TLtdWindow.Load(S);
  449.   GetSubViewPtr(S, DMX);
  450. end;
  451.  
  452.  
  453. procedure TDmxViewer.InitDMX(ATemplate: string;
  454.                   var AData;
  455.                   ALabels,ARecInd: PDmxLink;
  456.                   BSize: longint);
  457. var  R    : TRect;
  458. begin
  459.   GetExtent(R);
  460.   R.Grow(-1,-1);
  461.   If (ALabels <> nil) then Inc(R.A.Y, ALabels^.Size.Y);
  462.   Insert(New(PDmxScroller, Init(ATemplate, AData, BSize, R, ALabels,
  463.                    StandardScrollBar(sbHorizontal),
  464.                    StandardScrollBar(sbVertical))));
  465. end;
  466.  
  467.  
  468. function  TDmxViewer.NewDmxLabels(var ALabels ) : PDmxLink;
  469. begin
  470.   If (@ALabels = nil) or (string(ALabels) = '') then
  471.     NewDmxLabels := nil
  472.    else
  473.     NewDmxLabels := New(PDmxLabels, InitInsert(@Self, @ALabels));
  474. end;
  475.  
  476.  
  477. procedure TDmxViewer.Store(var S: TStream);
  478. begin
  479.   TLtdWindow.Store(S);
  480.   PutSubViewPtr(S, DMX);
  481. end;
  482.  
  483.  
  484. function  TDmxViewer.Valid(Command: word) : boolean;
  485. var  Len : integer;
  486.      V     : boolean;
  487. begin
  488.   V := TLtdWindow.Valid(Command);
  489.   If V and (Command = cmValid) then
  490.     begin
  491.     If (DMX = nil) then DMX := Message(@Self, evCommand, cmDMX_RollCall, nil);
  492.     If (DMX <> nil) and (DMX^.Labels <> nil) then
  493.       begin
  494.       If (Limit.A.Y > 0) then Limit.A.Y := succ(Size.Y - DMX^.Size.Y);
  495.       Limit.B.X    := PDmxLabels(DMX^.Labels)^.Len + (Size.X - DMX^.Size.X);
  496.       Len    := length(GetTitle(MaxViewWidth)) + 12;
  497.       If (Len > ScreenWidth) then Len := ScreenWidth;
  498.       If (Len > Limit.B.X) then Limit.B.X := Len;
  499.       If (Limit.B.X < MinWinSize.X) then Limit.B.X := MinWinSize.X;
  500.       end;
  501.     end;
  502.   Valid := V;
  503. end;
  504.  
  505.  
  506.   { ══ TDmxWindow ════════════════════════════════════════════════════════ }
  507.  
  508.  
  509. constructor TDmxWindow.Init(var Bounds       : TRect;
  510.                 ATitle     : TTitleStr;
  511.                 ANumber    : integer;
  512.                 ATemplate  : string;
  513.                 var AData;
  514.                 BSize       : longint;
  515.                 var ALabels    : string;
  516.                 IndLen     : integer);
  517. const  NilWin    : array[0..1] of Longint = (0,0);
  518. begin
  519.   TLtdWindow.Init(Bounds, TRect(NilWin), ATitle, ANumber);
  520.   InitDMX(ATemplate, AData, NewDmxLabels(ALabels), NewRecInd(IndLen), BSize);
  521.   Options := Options or ofTileable;
  522. end;
  523.  
  524.  
  525. procedure TDmxWindow.InitDMX(ATemplate: string;  var AData;
  526.                  ALabels, ARecInd: PDmxLink;
  527.                  BSize: longint);
  528. var  R    : TRect;
  529. begin
  530.   GetExtent(R);
  531.   R.Grow(-1,-1);
  532.   If (ALabels <> nil) then Inc(R.A.Y, ALabels^.Size.Y);
  533.   Insert(New(PDmxEditor, Init(ATemplate, AData, BSize, R,
  534.                 ALabels, ARecInd,
  535.                 StandardScrollBar(sbHorizontal),
  536.                 StandardScrollBar(sbVertical))));
  537. end;
  538.  
  539.  
  540. function  TDmxWindow.NewRecInd(Len: integer) : PDmxLink;
  541. begin
  542.   If (Len <= 0) then
  543.     NewRecInd := nil
  544.    else
  545.     NewRecInd := New(PDmxRecInd, InitInsert(@Self, Len));
  546. end;
  547.  
  548.  
  549.   { ══════════════════════════════════════════════════════════════════════ }
  550.  
  551.  
  552. procedure RegisterStdDMX;
  553. begin
  554.   RegisterType(RDmxEditDlg);
  555.   RegisterType(RInputFields);
  556.   RegisterType(RDmxViewer);
  557.   RegisterType(RDmxWindow);
  558. end;
  559.  
  560.  
  561.   { ══════════════════════════════════════════════════════════════════════ }
  562.  
  563.  
  564.  
  565. End.
  566.